home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / files.swg / 0051_Change File Extensions.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-02-03  |  2.7 KB  |  114 lines
  1. {$S-,V-,R-,F+}
  2.  
  3. PROGRAM REX;
  4.  
  5.  { Rename all files matching one extension with another
  6.    CAUTION !!!  This program will rename FILES !!!!!!!!
  7.    Takes to parameters : Ext1(current) and Ext2(whatever)
  8.    i.e.   *.XXX to *.PAS or *.MOD to *.INT
  9.    Uses some of the routines from EDDY THILLEMAN'S recursive directory roam
  10.    whice can be found in the SWAG distribution
  11.    Gayle Davis 1/26/94 }
  12.  
  13. USES DOS, CRT;
  14.  
  15. TYPE
  16.     ProcessType = PROCEDURE (Path : PathStr; FR : SearchRec);
  17.  
  18. CONST
  19.     NotGoodFile : WORD = Directory + Hidden + Readonly + VolumeID + Sysfile;
  20.  
  21. VAR
  22.      Ext1 : Pathstr;
  23.      Ext2 : Pathstr;
  24.      ExitSave : POINTER;
  25.  
  26. PROCEDURE Frename (SourceFile, TargetFile : STRING; VAR ErrCode : BYTE);
  27. VAR
  28.   reg : REGISTERS;
  29. BEGIN                                   { Frename }
  30.   SourceFile := CONCAT (SourceFile, #0);
  31.   TargetFile := CONCAT (TargetFile, #0);
  32.   reg.ds := SEG (SourceFile [1]); reg.dx := OFS (SourceFile [1]);
  33.   reg.es := SEG (TargetFile [1]); reg.di := OFS (TargetFile [1]);
  34.   reg.ah := $56;
  35.   MSDOS (reg);
  36.   ErrCode := 0;
  37.   IF (reg.flags AND FCarry) = 1 THEN ErrCode := reg.ax;
  38. END;                                    { Frename }
  39.  
  40. PROCEDURE DoitHere (Path : PathStr; FR : SearchRec); FAR;
  41. VAR
  42.    Name1,
  43.    Name2 : PathStr;
  44.    D     : PathStr;
  45.    N     : NameStr;
  46.    E     : ExtStr;
  47.    Err   : BYTE;
  48.  
  49. BEGIN
  50. IF (FR.Attr AND NotGoodFile) <> 0 THEN EXIT;
  51. FSplit(FR.Name, D, N, E);
  52. Name1 := Path + FR.Name;
  53. Name2 := Path + N + Ext2;
  54. WRITELN (Name1, ' ', Name2);
  55. FRename(Name1,Name2,Err);
  56. END;
  57.  
  58. FUNCTION Wildcard (Name : PathStr) : BOOLEAN ;
  59.  
  60. BEGIN
  61. Wildcard := (POS ('*', Name) <> 0) OR (POS ('?', Name) <> 0) AND (POS('.',Name) > 0);
  62. END ;
  63.  
  64.  
  65. Procedure PathAnalyze (P: PathStr; Var D: DirStr; Var Name: NameStr);
  66. Var
  67.   N: NameStr;
  68.   E: ExtStr;
  69.  
  70. begin
  71.   FSplit(P, D, N, E);
  72.   Name := N + E;
  73. end;
  74.  
  75. PROCEDURE FindFiles (fMask : PathStr; fAttr : WORD; Process : ProcessType);
  76. VAR
  77.   FR   : SearchRec;
  78.   Path : PathStr;
  79.   Mask : NameStr;
  80.  
  81. BEGIN
  82.   PathAnalyze(fMask,Path,Mask);
  83.   FINDFIRST (FMask, FAttr, FR);
  84.   WHILE DosError = 0 DO
  85.   BEGIN
  86.     Process (Path,FR);
  87.     FINDNEXT (FR);
  88.   END;
  89. END;
  90.  
  91. PROCEDURE ExitHandler; FAR;
  92.   { Return the cursor to its original shape }
  93.   BEGIN
  94.   ExitProc := ExitSave
  95.   END;
  96.  
  97.  
  98. BEGIN
  99. ExitSave := ExitProc;
  100. ExitProc := @ExitHandler;
  101. ClrScr;
  102. IF PARAMCOUNT < 2 THEN
  103.    BEGIN
  104.    WriteLn('REX : Rename all files matching Ext1 to Ext2');
  105.    WRITELN('Needs 2 Parameters ..   *.ext1  *.ext2');
  106.    HALT;
  107.    END;
  108. Ext1 := ParamStr(1);
  109. Ext2 := ParamStr(2);
  110. IF NOT WildCard(Ext1) THEN HALT;  { must contain a wildcard }
  111. IF NOT WildCard(Ext2) THEN HALT;
  112. Ext2 := COPY(Ext2,POS('.',Ext2),$FF);  { only want the extension }
  113. FindFiles (Ext1, Anyfile, DoitHere);
  114. END.